COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin comment near-optimal Boolean evaluation on MIX
C00003 00003	basic table access procedures
C00005 00004	building the bit-manipulation tables
C00009 00005	procedure build_next_level
C00010 00006	the main program
C00011 ENDMK
C⊗;
begin comment near-optimal Boolean evaluation on MIX;
external procedure bail;
boolean debug;
integer ochan,oflg,eof,lmem,tw,tr,z,avail,k,tlast,j,p;
integer array marks[0:'77777];comment six 6-bit fields, for each state;
define size=40000;
integer array mem[0:size]; comment linked lists;
label quit,term;
integer array name,cost,newstate[0:35],msk,sh[0:35,0:8];
integer array start[0:2],x[0:4];
comment basic table access procedures;

integer procedure fetch(integer t);
begin tw←t land '77777; tr←6*(t lsh -15);
lmem←marks[tw] rot tr;
return(lmem land '77);
end;

procedure store(integer c);
begin comment store into the 6-bit field most recently fetched;
marks[tw]←((lmem land '777777777700)+c) rot (-tr);
end;

procedure insert(integer t,x,b);
begin comment insert new specification entry into list b, if it
represents a new shortest path, where x explains how entry was obtained;
integer m,kp,q;
if (kp←k+b) < (m←fetch(t)) then
	begin store(kp);
	wordout(ochan,t); wordout(ochan,(kp lsh 30)+x);
	if debug then print(cvos(t),cvos((kp lsh 30)+x),'15&'12);
	if avail=0 then begin print("overflow",z);go to quit end;
	q←mem[avail];
	mem[avail]←(t lsh 16)+mem[b];
	mem[b]←avail;
	avail←q;
	end;
end;

procedure initialize;
begin integer j;
for j←3 step 1 until size-1 do mem[j]←j+1;
avail←3; mem[size]←mem[0]←mem[1]←mem[2]←0;
for j←0 step 1 until '77777 do marks[j]←-1;
z←0;k←-1; insert('377,((12 lsh 5)+1) lsh 20,1);comment cost of X1, a state, is 0;
end;
comment building the bit-manipulation tables;
boolean swp; comment is x[1] being swapped with x[j];

integer procedure f(integer w,x,y,z);
return((((((w lsh 1)+x) lsh 1)+y) lsh 1)+z);

integer procedure y(integer k);
return(if (j=k) and swp then x[1] else x[k]);

integer procedure id; return(f(x[1],x[2],x[3],x[4]));
integer procedure com; return(f(1-x[1],x[2],x[3],x[4]));
integer procedure zero; return(f(0,x[2],x[3],x[4]));
integer procedure andj; return(f(x[1] land x[j], y(2),y(3),y(4)));
integer procedure orj; return(f(x[1] lor x[j], y(2),y(3),y(4)));
integer procedure xorj; return(f(x[1] xor x[j], y(2),y(3),y(4)));
integer procedure swapj; return(f(x[j], y(2),y(3),y(4)));
integer procedure cswp; return(f(1-x[1], y(2),y(3),y(4)));

procedure b(integer op,addr,cst,nst; integer procedure g);
begin integer u,v,t,i;
x[0]←x[1]←x[2]←x[3]←x[4]←sh[p,0]←msk[p,0]←0;
while x[0]=0 do
	begin u←f(x[1],x[2],x[3],x[4]); v←g;
	if u≠v then
		begin i←0;
		while(sh[p,i]≠0)and(sh[p,i]≠v-u) do i←i+1;
		if sh[p,i]=0 then
			begin sh[p,i+1]←msk[p,i+1]←0; sh[p,i]←v-u;
			end;
		msk[p,i]←msk[p,i] lor(1 lsh(15-u));
		end;
	k←4; while x[k]=1 do begin x[k]←0; k←k-1 end;
	x[k]←1;
	end;
name[p]←((op lsh 5)+ addr) lsh 20;
cost[p]←cst; newstate[p]←nst;
p←p+1;
end;

procedure build_shift_tables;
begin start[0]←p←0;
comment instructions assuming X1 in rA and X2...X4 in memory;
b(0,0,0,2,id); comment in particular, when X1 also in memory;
b(4,0,1,0,com); comment COM;
b(11,1,2,2,zero); comment XOR X1;
swp←false;
for j←2 step 1 until 4 do
	begin b(6,j,2,0,andj);comment AND Xj;
	b(8,j,2,0,orj); comment OR Xj;
	b(10,j,2,0,xorj); comment XOR Xj;
	end;
swp←true;
for j←2 step 1 until 4 do
	begin b(7,j,2,2,andj); comment X1↔Xj then AND Xj;
	b(9,j,2,2,orj); comment X1↔Xj then OR Xj;
	b(11,j,2,2,xorj); comment X1↔Xj then XOR Xj;
	b(5,j,1,2,cswp); comment COM then X1→Xj;
	end;
name[p]←-1;p←p+1; start[1]←p; 
comment instructions assuming X1...X4 all in memory;
b(0,0,0,2,id); comment in particular, when X1 also in rA;
for j←2 step 1 until 4 do b(1,j,0,1,swapj); comment X1↔Xj notationally;
name[p]←-1;p←p+1; start[2]←p;
comment instructions assuming X1 in rA and X1...X4 in memory;
b(3,0,2,0,id); comment LDA X1;
b(2,0,2,1,id); comment STA X1;
name[p]←-1;
end;
procedure build_next_level;
begin integer p,t,expl,i,tt;
k←k+1; mem[0]←mem[1]; mem[1]←mem[2]; mem[2]←0;
while (p←mem[0])≠0 do
	begin t←mem[p]; mem[0]← t land '177777; t←t lsh -16;
	mem[p]←avail; avail←p;
	if fetch(t)=k then
		begin tlast←t;
		if (z←z+1)>'577777 then go to term;
		p←start[t lsh -16]; t←t land '177777;
		tt←t;
		while (expl←name[p])≥0 do
			begin i←0; t←tt;
			while sh[p,i]≠0 do
				begin t←(((tt lsh sh[p,i])xor t)
					land msk[p,i]) xor t;
				i←i+1;
				end;
			insert((newstate[p] lsh 16)+t, expl+tlast,cost[p]);
			p←p+1;
			end;
		end;
	end;
end;
comment the main program;

debug←true;
bail;
setformat(15,15);
open(ochan←getchan,"DSK",8,0,2,256,oflg,eof);
enter(ochan,"BOOL.OUT",oflg);
build_shift_tables;
initialize;
while true do 
	begin build_next_level;
	print(k,z,cvos(tlast),'15&'12);
	end;
term:print(k,z,cvos(tlast),'15&'12);
quit:wordout(ochan,-1); close(ochan);
end